MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 07 - 1991/07.06 Jun 91/Fancy Dialogs Code/TDialog.p

Text File | 1991-03-18 | 19.4 KB | 1,013 lines | [TEXT/PJMM]

{ Methods for TDialog. }

{ Written by Thomas Engel, M.D. }
{ Copyright © 1991 MacTutor. }


unit TDialog;

interface

    uses
        SANE, Globals;


    function DialogFilter (toolboxDialog: DialogPtr; var theEvent: EventRecord; var itemHit: Integer): Boolean;


implementation


    function DialogFilter (toolboxDialog: DialogPtr; var theEvent: EventRecord; var itemHit: Integer): Boolean;

    { Dialog filter function. }

        var
            theDialog: TDialog;

    begin
        theDialog := TDialog(DialogPeek(toolboxDialog)^.window.refCon);
        DialogFilter := theDialog.EventFilter(theEvent, itemHit)
    end;


    procedure TDialog.IDialog (dialogID: Integer; default, cancel, text: Integer; dismiss: DialogItemSet; centered: Boolean);

    { Initialize dialog. }

    begin
        defaultItem := default;
        cancelItem := cancel;
        defaultText := text;
        dismissSet := dismiss;
        itemCount := 0;
        toolboxDialog := GetNewDialog(dialogID, nil, pointer(-1));
        toolboxDPeek := DialogPeek(toolboxDialog);
        if toolboxDialog <> nil then
            begin
                toolboxDPeek^.window.refCon := Longint(self);
                itemCount := IntegerHandle(toolboxDPeek^.items)^^ + 1
            end;
        if centered then
            Center
    end;


    procedure TDialog.Free;

    { Free memory used by this object. }

    begin
        if toolboxDialog <> nil then
            DisposDialog(toolboxDialog);
        HUnlock(Handle(self));
        DisposHandle(Handle(self))
    end;


    procedure TDialog.Center;

    { Center the dialog on the main screen. }

        var
            width, height: Integer;

    begin
        if toolboxDialog <> nil then
            begin
                with toolboxDialog^.portRect do
                    begin
                        width := right - left;
                        height := bottom - top
                    end;
                with ScreenBits.bounds do
                    MoveWindow(toolboxDialog, left + (right - left - width) div 2, top + (bottom - top - height) div 3, false)
            end
    end;


    function TDialog.Show: Integer;

    { Show the dialog. }

        var
            itemHit: Integer;

    begin
        Show := 0;
        if toolboxDialog <> nil then
            begin
                if defaultText > 0 then
                    SelIText(toolboxDialog, defaultText, 0, 32767);
                ShowWindow(toolboxDialog);
                InitCursor;
                repeat
                    ModalDialog(@DialogFilter, itemHit);
                    if itemHit > 0 then
                        Hit(itemHit);
                until (itemHit > 0) and (itemHit in dismissSet);
                Show := itemHit
            end
    end;


    procedure TDialog.Hide;

    { Hide the dialog. }

    begin
        if toolboxDialog <> nil then
            HideWindow(toolboxDialog);
    end;


    function TDialog.EventFilter (var theEvent: EventRecord; var itemHit: Integer): Boolean;

    { Dialog event filter. }

        var
            savePort: GrafPtr;
            ch: Char;
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
            editItem: Integer;

    begin

        { Save current port. }

        GetPort(savePort);
        SetPort(toolboxDialog);

        { Fix cursor. }

        FixCursor;

         { Check the event. }

        case theEvent.what of

            keyDown, autoKey:
                begin
                    ch := Chr(BitAnd(theEvent.message, CharCodeMask));

                   { Handle default item. }

                    if (ch in [ReturnCh, EnterCh]) and (defaultItem > 0) then
                        begin
                            FlashItem(defaultItem);
                            itemHit := defaultItem;
                            EventFilter := true
                        end

                    { Handle cancel item. }

                    else if (BitAnd(theEvent.modifiers, CmdKey) <> 0) and (ch in ['.']) and (cancelItem > 0) then
                        begin
                            FlashItem(cancelItem);
                            itemHit := cancelItem;
                            EventFilter := true
                        end

                    { Handle tab key. }

                    else if (ch in [TabCh]) and (toolboxDPeek^.editField <> -1) then
                        begin
                            if BitAnd(theEvent.modifiers, ShiftKey) <> 0 then
                                begin

                                    { Find previous edit item. }

                                    editItem := toolboxDPeek^.editField + 1;
                                    repeat
                                        if editItem = 1 then
                                            editItem := itemCount
                                        else
                                            editItem := editItem - 1;
                                        GetDItem(toolboxDialog, editItem, itemType, itemHandle, itemRect);
                                    until itemType = editText;
                                end
                            else
                                begin

                                    { Find next edit item. }

                                    editItem := toolboxDPeek^.editField + 1;
                                    repeat
                                        if editItem = itemCount then
                                            editItem := 1
                                        else
                                            editItem := editItem + 1;
                                        GetDItem(toolboxDialog, editItem, itemType, itemHandle, itemRect);
                                    until itemType = editText
                                end;

                            { Select the edit field. }

                            SelIText(toolboxDialog, editItem, 0, 32767);
                            itemHit := editItem;
                            EventFilter := true
                        end

                    { Handle keyboard commands. }

                    else if BitAnd(theEvent.modifiers, CmdKey) <> 0 then
                        begin
                            Command(ch, itemHit);
                            EventFilter := true
                        end

                    { Handle other typing. }

                    else
                        EventFilter := false
                end;

            updateEvt:
                begin
                    BeginUpdate(toolboxDialog);
                    UpdtDialog(toolboxDialog, toolboxDialog^.visRgn);
                    Draw;
                    EndUpdate(toolboxDialog);
                    EventFilter := true
                end;

            otherwise
                EventFilter := false
        end;

        { Restore port. }

        SetPort(savePort)
    end;


    procedure TDialog.FixCursor;

    { Fix the cursor. }

        var
            localMouse: Point;
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        if toolboxDPeek^.editField <> -1 then
            begin
                GetMouse(localMouse);
                GetDItem(toolboxDialog, toolboxDPeek^.editField + 1, itemType, itemHandle, itemRect);
                if PtInRect(localMouse, itemRect) then
                    SetCursor(IBeam^^)
                else
                    InitCursor
            end
    end;


    procedure TDialog.Command (ch: Char; var itemHit: Integer);

    { Handle keyboard command. }

    begin
        if toolboxDPeek^.editField <> -1 then
            begin
                if ch in ['X', 'x'] then
                    begin
                        DlgCut(toolboxDialog);
                        itemHit := toolboxDPeek^.editField + 1
                    end
                else if ch in ['C', 'c'] then
                    begin
                        DlgCopy(toolboxDialog);
                        itemHit := toolboxDPeek^.editField + 1
                    end
                else if ch in ['V', 'v'] then
                    begin
                        DlgPaste(toolboxDialog);
                        itemHit := toolboxDPeek^.editField + 1
                    end
                else if ch in ['B', 'b'] then
                    begin
                        DlgDelete(toolboxDialog);
                        itemHit := toolboxDPeek^.editField + 1
                    end
            end
    end;

    procedure TDialog.Hit (var itemHit: Integer);

    { Special handling for item hit. }

    begin
    end;


    procedure TDialog.Draw;

    { Draw extra dialog embellishments. }

    begin
        DrawDefault;
    end;


    procedure TDialog.DrawDefault;

    { Outline the default button. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect, outlineRect: Rect;

    begin
        if defaultItem > 0 then
            begin
                GetDItem(toolboxDialog, defaultItem, itemType, itemHandle, itemRect);
                outlineRect := itemRect;
                InsetRect(outlineRect, -4, -4);
                PenSize(3, 3);
                FrameRoundRect(outlineRect, 16, 16);
                PenNormal
            end
    end;


    procedure TDialog.DrawBox (itemSet: DialogItemSet; margin, thickness: Integer);

    { Draw a box around a set of dialog items. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect, boxRect: Rect;
            item: Integer;

    begin

        { Get the enclosing rectangle. }

        SetRect(boxRect, 0, 0, 0, 0);
        for item := 1 to itemCount do
            if item in itemSet then
                begin
                    GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
                    if EmptyRect(boxRect) then
                        boxRect := itemRect
                    else
                        UnionRect(boxRect, ItemRect, boxRect)
                end;

        { Draw the box. }

        if not EmptyRect(boxRect) then
            begin
                InsetRect(boxRect, -(margin + thickness), -(margin + thickness));
                PenSize(thickness, thickness);
                FrameRect(boxRect);
                PenNormal
            end
    end;


    procedure TDialog.DrawTitleBox (itemSet: DialogItemSet; margin, thickness: Integer; title: Str255);

    { Draws a box around a set of dialog items. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect, boxRect: Rect;
            item: Integer;
            theInfo: FontInfo;

    begin

        { Get the enclosing rectangle. }

        SetRect(boxRect, 0, 0, 0, 0);
        for item := 1 to itemCount do
            if item in itemSet then
                begin
                    GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
                    if EmptyRect(boxRect) then
                        boxRect := itemRect
                    else
                        UnionRect(boxRect, ItemRect, boxRect)
                end;

        { Draw the box and the title. }

        if not EmptyRect(boxRect) then
            begin
                GetFontInfo(theInfo);
                with boxRect, theInfo do
                    begin
                        left := left - margin - thickness;
                        top := top - descent - margin - thickness;
                        right := right + margin;
                        bottom := bottom + margin;
                        PenSize(thickness, thickness);
                        MoveTo(left, top);
                        Line(margin + 2, 0);
                        Move(thickness + 1, (ascent + descent) div 2 - descent);
                        DrawString(title);
                        Move(1, -((ascent + descent) div 2 - descent));
                        LineTo(right, top);
                        LineTo(right, top);
                        LineTo(right, bottom);
                        LineTo(left, bottom);
                        LineTo(left, top);
                        PenNormal
                    end
            end
    end;


    procedure TDialog.FlashItem (item: Integer);

    { Hilight the dialog item for a few ticks. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
            finalTicks: Longint;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, ctrlItem) <> 0 then
            begin
                HiliteControl(ControlHandle(itemHandle), ControlOn);
                Delay(FlashTicks, finalTicks);
                HiliteControl(ControlHandle(itemHandle), ControlOff);
                Delay(AfterTicks, finalTicks)
            end
    end;


    function TDialog.GetText (item: Integer): Str255;

    { Get the dialog item text string. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
            text: Str255;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, statText + editText) <> 0 then
            GetIText(itemHandle, text)
        else
            text := '';
        GetText := text
    end;


    procedure TDialog.SetText (item: Integer; text: Str255);

    { Set the dialog item text string. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, statText + editText) <> 0 then
            begin
                SetIText(itemHandle, text);
                if toolboxDPeek^.editField + 1 = item then
                    SelIText(toolboxDialog, item, 0, 32767);
            end
    end;


    function TDialog.GetInteger (item: Integer): Longint;

    { Get an integer value from the dialog item text. }

        var
            text: Str255;
            value: Longint;

    begin
        text := GetText(item);
        StringToNum(text, value);
        GetInteger := value
    end;


    procedure TDialog.SetInteger (item: Integer; value: Longint);

    { Set the dialog item text string to represent an integer. }

        var
            text: Str255;

    begin
        NumToString(value, text);
        SetText(item, text)
    end;


    function TDialog.GetReal (item: Integer): Extended;

    { Get a real value from the dialog item text. }

        var
            text: Str255;
            value: Extended;

    begin
        text := GetText(item);
        value := Str2Num(text);
        GetReal := value
    end;


    procedure TDialog.SetReal (item: Integer; value: Extended; places: Integer);

    { Set the dialog item text string to represent a real number. }

        var
            format: DecForm;
            text: DecStr;

    begin
        SetRound(ToNearest);
        format.style := FixedDecimal;
        format.digits := places;
        Num2Str(format, value, text);
        SetText(item, text)
    end;


    function TDialog.GetControlValue (item: Integer): Integer;

    { Get the control value. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
            value: Integer;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, ctrlItem) <> 0 then
            value := GetCtlValue(ControlHandle(itemHandle))
        else
            value := 0;
        GetControlValue := value
    end;


    procedure TDialog.SetControlValue (item: Integer; value: Integer);

    { Set the control value. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, ctrlItem) <> 0 then
            SetCtlValue(ControlHandle(itemHandle), value)
    end;


    function TDialog.GetControlTitle (item: Integer): Str255;

    { Get the control title. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;
            title: Str255;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, ctrlItem) <> 0 then
            GetCTitle(ControlHandle(itemHandle), title)
        else
            title := '';
        GetControlTitle := title
    end;


    procedure TDialog.SetControlTitle (item: Integer; title: Str255);

    { Set the control title. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, ctrlItem) <> 0 then
            SetCTitle(ControlHandle(itemHandle), title)
    end;


    function TDialog.GetRadioItem (radioSet: DialogItemSet): Integer;

    { Get the selected radio button. }

        var
            item, value: Integer;
            itemSelected: Integer;

    begin
        itemSelected := 0;
        item := 1;
        while (itemSelected = 0) and (item <= itemCount) do
            begin
                if item in radioSet then
                    if GetControlValue(item) = ControlOn then
                        itemSelected := item;
                item := item + 1
            end;
        GetRadioItem := itemSelected
    end;


    procedure TDialog.SetRadioItem (radioSet: DialogItemSet; itemSelected: Integer);

    { Set the selected radio button. }

        var
            item: Integer;

    begin
        if itemSelected in radioSet then
            for item := 1 to itemCount do
                if item in radioSet then
                    if item = itemSelected then
                        SetControlValue(item, ControlOn)
                    else
                        SetControlValue(item, ControlOff)
    end;


    procedure TDialog.SetIcon (item: Integer; iconID: Integer);

    { Set icon item. }

        var
            theIcon: Handle;
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        theIcon := GetIcon(iconID);
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if (BitAnd(itemType, iconItem) <> 0) and (theIcon <> nil) then
            SetDItem(toolboxDialog, item, itemType, Handle(theIcon), itemRect)
    end;


    procedure TDialog.SetPicture (item: Integer; pictureID: Integer);

    { Set picture item. }

        var
            thePicture: PicHandle;
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        thePicture := GetPicture(pictureID);
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if (BitAnd(itemType, picItem) <> 0) and (thePicture <> nil) then
            SetDItem(toolboxDialog, item, itemType, Handle(thePicture), itemRect)
    end;


    procedure TDialog.SetUserItem (item: Integer; userProc: ProcPtr);

    { Set the dialog user item procedure. }

        var
            itemType: Integer;
            itemHandle: Handle;
            itemRect: Rect;

    begin
        GetDItem(toolboxDialog, item, itemType, itemHandle, itemRect);
        if BitAnd(itemType, userItem) <> 0 then
            SetDItem(toolboxDialog, item, itemType, Handle(userProc), itemRect)
    end;


    procedure TAboutDialog.IAboutDialog;

    { Initialize about dialog. }

    begin
        IDialog(AboutID, OKButton, 0, 0, [OKButton], true)
    end;


    function TAboutDialog.Show: Integer;

    { Show about dialog. }

        var
            s: Str255;

    begin
        NumToString(MaxBlock div 1024, s);
        s := Concat(s, 'K ', GetText(3));
        SetText(3, s);
        Show := inherited Show
    end;


    procedure TMessageDialog.IMessageDialog (message: Str255; iconID: Integer);

    { Initialize message dialog. }

    begin
        IDialog(MessageID, OKButton, 0, 0, [OKButton], true);
        SetIcon(2, iconID);
        SetMessage(message)
    end;


    procedure TMessageDialog.SetMessage (message: Str255);

    {Set message text string. }

    begin
        SetText(3, message)
    end;


    procedure TStringDialog.IStringDialog (prompt, default: Str255);

    { Initialize string dialog. }

    begin
        IDialog(StringID, OKButton, CancelButton, 4, [OKButton, CancelButton], true);
        SetData(prompt, default)
    end;


    procedure TStringDialog.SetData (prompt, default: Str255);

    { Set prompt and default text strings. }

    begin
        SetText(3, prompt);
        SetText(4, default)
    end;


    procedure TStringDialog.GetData (var response: Str255);

    { Get string. }

    begin
        response := GetText(4)
    end;


    procedure TYesNoDialog.IYesNoDialog (prompt: Str255; default: Integer);

    { Initialize Yes/No dialog. }

    begin
        IDialog(YesNoID, default, 0, 0, [YesButton, NoButton], true);
        SetPrompt(prompt)
    end;


    procedure TYesNoDialog.SetPrompt (prompt: Str255);

    { Set prompt text string. }

    begin
        SetText(2, prompt)
    end;


    procedure TYesNoCancelDialog.IYesNoCancelDialog (prompt: Str255; default: Integer);

    { Initialize Yes/No/Cancel dialog. }

    begin
        IDialog(YesNoCancelID, default, CancelButton, 0, [YesButton, NoButton, CancelButton], true);
        SetPrompt(prompt)
    end;


    procedure TYesNoCancelDialog.SetPrompt (prompt: Str255);

    { Set prompt text string. }

    begin
        SetText(4, prompt)
    end;


    procedure TMarginsDialog.IMarginsDialog (defaultMargins: MarginRecord);

    { Initialize page margins dialog. }

    begin
        IDialog(PageMarginsID, OKButton, CancelButton, 5, [OKButton, CancelButton], true);
        measureSet := [12, 13, 14];
        SetData(defaultMargins)
    end;


    procedure TMarginsDialog.Draw;

    { Draw. }

    begin
        DrawTitleBox(measureSet, 3, 1, 'Measure');
        DrawDefault
    end;


    procedure TMarginsDialog.Hit (var itemHit: Integer);

    { Item hit. }
        var
            oldItem: Integer;
            factor: Extended;
            places: Integer;

    begin
        if itemHit in measureSet then
            begin

                { Convert margin values to new units. }

                oldItem := GetRadioItem(measureSet);
                if oldItem <> itemHit then
                    begin
                        if (oldItem = 12) and (itemHit = 13) then
                            begin

                                { Inches to cm. }

                                factor := 2.54;
                                places := 2
                            end
                        else if (oldItem = 12) and (itemHit = 14) then
                            begin

                                { Inches to points. }

                                factor := 72.0;
                                places := 0
                            end
                        else if (oldItem = 13) and (itemHit = 12) then
                            begin

                                { Cm to inches. }

                                factor := 1.0 / 2.54;
                                places := 2
                            end
                        else if (oldItem = 13) and (itemHit = 14) then
                            begin

                                { cm to points. }

                                factor := 1.0 / 2.54 * 72.0;
                                places := 0
                            end
                        else if (oldItem = 14) and (itemHit = 12) then
                            begin

                                { Points to inches. }

                                factor := 1.0 / 72.0;
                                places := 2
                            end
                        else if (oldItem = 14) and (itemHit = 13) then
                            begin

                                { Points to cm. }

                                factor := 1.0 / 72.0 * 2.54;
                                places := 2
                            end;

                        SetReal(5, GetReal(5) * factor, places);
                        SetReal(7, GetReal(7) * factor, places);
                        SetReal(9, GetReal(9) * factor, places);
                        SetReal(11, GetReal(11) * factor, places);
                    end;

                SetRadioItem(measureSet, itemHit)
            end
    end;


    procedure TMarginsDialog.SetData (newMargins: MarginRecord);

    { Set the page margin values. }

        var
            places: Integer;

    begin
        case newMargins.measure of

            inches:
                begin
                    SetRadioItem(measureSet, 12);
                    places := 2
                end;

            cm:
                begin
                    SetRadioItem(measureSet, 13);
                    places := 2
                end;

            points:
                begin
                    SetRadioItem(measureSet, 14);
                    places := 0
                end;

        end;

        SetReal(5, newMargins.top, places);
        SetReal(7, newMargins.bottom, places);
        SetReal(9, newMargins.left, places);
        SetReal(11, newMargins.right, places)
    end;


    procedure TMarginsDialog.GetData (var theMargins: MarginRecord);

    { Get the page margin values. }

    begin
        case GetRadioItem(measureSet) of

            12:
                theMargins.measure := inches;

            13:
                theMargins.measure := cm;

            14:
                theMargins.measure := points;

        end;
        theMargins.top := GetReal(5);
        theMargins.bottom := GetReal(7);
        theMargins.left := GetReal(9);
        theMargins.right := GetReal(11)
    end;


    procedure TFontSizeDialog.IFontSizeDialog (defaultSize: Integer);

    { Initialize font size dialog. }

    begin
        IDialog(FontSizeID, OKButton, CancelButton, 4, [OKButton, CancelButton], true);
        SetData(defaultSize)
    end;


    procedure TFontSizeDialog.SetData (fontSize: Integer);

    { Set the font size. }

    begin
        SetInteger(4, fontSize)
    end;


    procedure TFontSizeDialog.GetData (var fontSize: Integer);

    { Get the font size. }

    begin
        fontSize := GetInteger(4)
    end;


end.